home *** CD-ROM | disk | FTP | other *** search
/ PC Electronics Plus 3 / PC Electronics Plus 3.iso / subdwg / lsp / gvista.lsp < prev    next >
Lisp/Scheme  |  1994-11-14  |  11KB  |  268 lines
  1. ;********************************************************************
  2. ;* Comando: Gvista ()
  3. ;* Comentarios: este comando se usa para generar los cortes y las
  4. ;* distintas vistas (x,y,z,-x,-y,-z,3d) de la subestacion a partir
  5. ;* de plano 3d de esta. El comando pregunta la vista que se desea
  6. ;* generar y los objetos a los cuales se les quiere crear la vista
  7. ;* .Si la vista no existe para un bloque, se copia el bloque mismo
  8. ;* en caso contrario se reemplaza el bloque por la vista dada. La
  9. ;* vista generada se convierte en bloque.
  10. ;******************************************************************** 
  11.  
  12. ; Change log
  13. ;
  14. ; 25/10/94 C. Perigault   Modifique la insercion del bloque para que
  15. ;                         fuera en el mismo lugar que el alambre
  16. ;
  17. ; 25/10/94 C. Perigault   Modifique la escala del bloque para que 
  18. ;                         fuera la misma que el bloque alambre
  19. ;
  20. ;  8/11/94 C. Perigault   Agrege el sinonimo genera-vista para mantener
  21. ;                         la compatibilidad con la memoria
  22. ;
  23. ; 8/11/94  C. Perigault   Elime la vista 3d ya que no es necesaria
  24. ;
  25. ;
  26. ; 8/11/94  C. Perigualt   Cambie la forma de insertar la vista, ahora
  27. ;                         el ucs se situa en la entidad y se inserta 
  28. ;                         la vista para que esta tenga misma posicion
  29. ;                         y rotacion que la original.
  30. ;
  31. (defun c:genera-vista () (c:Gvista)) ; sinonimo
  32.  
  33. (defun c:Gvista ( / osmode cmdecho gridmode ListaVistas ListaRotacion
  34.              conjunto NumeroDeEntidades NuevoConjunto i entidad
  35.              TipoEntidad NombreBloqueNuevo NombreBloque
  36.              sufijo prefijo  temp BloqueNuevo)
  37.  
  38.   (setq ucs 1)
  39.   (setq wcs 0)
  40. ;******************************************************************
  41. ;* Funcion    : Prefijo (vista entidad)
  42. ;* Parametros :
  43. ;*              - vista   : (x y z)
  44. ;*              - entidad : nombre de una entidad
  45. ;* Retorna :
  46. :* Un string que contiene el nombre de la vista , de no corresponder
  47. ;* a una de las vista normalizadas retorna "null".
  48. ;* Comentarios: Esta funcion es la base para encontrar el
  49. ;* bloque que se debe utilizar
  50. ;******************************************************************
  51. (defun PrefijoVista (vista entidad / ListaVistas)
  52.   ; En esta lista se define la correspondencia entre la vista y
  53.   ; el prefijo que corresponde a la vista
  54.   (setq ListaVistas '((( 1  0  0)  "x" )
  55.               (( 0  1  0)  "y" )
  56.               (( 0  0  1)  "z" )
  57.               ((-1  0  0) "-x" )
  58.               (( 0 -1  0) "-y" )
  59.               (( 0  0 -1) "-z" )))
  60.   
  61.       ; transformamos la vista al wcs que es el que usamos como
  62.       ; referencia
  63.       ;;; (setq vista (trans vista ucs wcs))
  64.       ; el sistema de coordenadas es ahora el de la entidad
  65.       (command "UCS" "E" entidad)
  66.       ; convertimos la vista del wcs a ucs que ahora equivale al
  67.       ; sistema de coordenadas de la entidad
  68.       (setq vista (VectorUnitario (RestaVector
  69.                     (trans   vista  wcs ucs)
  70.                     (trans '(0 0 0) wcs ucs))))
  71.       ; Redondeamos la vista para que no tengamos problemas por
  72.       ; errores de precision
  73.       (setq vista (list
  74.             (redondea (car   vista))
  75.             (redondea (cadr  vista))
  76.             (redondea (caddr vista))))
  77.       ; volvemos al sistema de coordenadas desde el cual nos
  78.       ; llamaron
  79.       (command "UCS" "P")
  80.       ; si existe el prefijo retornamos el prefijo en caso
  81.       ; contrario retormamos "null"
  82.       (if (cadr(assoc vista ListaVistas))
  83.     (cadr (assoc vista ListaVistas))
  84.     "null"))
  85. ;******************************************************************
  86. ;* Funcion    : RestaVector(v1 v2)
  87. ;* Parametros :
  88. ;*             - v1 : (x1 y1 z1)
  89. ;*             - v2 : (x2 y2 z2)
  90. ;* Retorna : La resta  v1-v2 en la forma ( x y z)
  91. ;******************************************************************
  92.  
  93. (defun RestaVector (v1 v2)
  94.   (list (- (car   v1)(car   v2))
  95.     (- (cadr  v1)(cadr  v2))
  96.     (- (caddr v1)(caddr v2))))
  97.  
  98. ;******************************************************************
  99. ;* Funcion : Redondea (x)
  100. ;*
  101. ;*
  102. ;******************************************************************
  103. (defun Redondea (x)
  104.    (if (minusp x) (fix (- x 0.5)) (fix (+ x 0.5))))
  105. ;******************************************************************
  106. ;* Funcio:VectorUnitario (v)
  107. ;* Parametros:
  108. ;*              - v :(x y z)
  109. ;*
  110. ;* Retorna: El vector unitario de v en la forma ( x y z)
  111. ;******************************************************************
  112.  
  113. (defun VectorUnitario (v / temp x y z)
  114.   (setq x (car v) y (cadr v) z (caddr v))
  115.   (setq temp (+ (* x x) (* y y) (* z z)))
  116.   (list
  117.     (/ x temp)
  118.     (/ y temp)
  119.     (/ z temp)))
  120. ;********************************************************************
  121. ;* Funcion : Rotacion (conjunto punto fi teta)
  122. ;* Parametros :
  123. ;*              - conjunto : entidades que se desean rotar
  124. ;*              - punto    : punto de rotacion
  125. ;*              - fi       : rotacion en el plano xy
  126. ;*              - teta     : rotacion con respecto al eje z
  127. ;*
  128. ;********************************************************************
  129. (defun Rotacion (conjunto  punto fi teta)
  130.   (setq punto (trans punto ucs wcs))
  131.   (command "ROTATE" conjunto "" (trans punto wcs ucs)  fi)
  132.   (command "UCS" "Y" "-90")
  133.   (command "ROTATE" conjunto "" (trans punto wcs ucs)  teta)
  134.   (command "UCS" "P"))
  135.  
  136.  
  137.  
  138.  
  139.   ; cambiamos las varibles del sistema para que no interfieran con
  140.   ; los comandos y para hacer mas rapida la ejecucion.
  141.   (setq osmode   (getvar "OSMODE"  ))
  142.   (setq cmdecho  (getvar "CMDECHO" ))
  143.   (setq gridmode (getvar "GRIDMODE"))
  144.   (setvar "GRIDMODE" 0)
  145.   (setvar "CMDECHO"  0)
  146.   (setvar "OSMODE"   0)
  147.   ;En esta lista guardamos la relacion que hay entre el nombre
  148.   ;de la vista y su coordenada
  149.   (setq ListaVistas '( ( "x"  ( 1  0  0))
  150.                ( "y"  ( 0  1  0))
  151.                ( "z"  ( 0  0  1))
  152.                ( "-x" (-1  0  0))
  153.                ( "-y" ( 0 -1  0))
  154.                ( "-z" ( 0  0 -1))))
  155.                
  156.   ;Esta lista guarda la relacion entre la vista y las rotacines
  157.   ;necesarias para ponerlos en el plano xy
  158.   (setq ListaRotacion '( ( ( 1  0  0)( -90  90))
  159.              ( ( 0  1  0)( 180  90))
  160.              ( ( 0  0  1)(   0   0))
  161.              ( (-1  0  0)(  90  90))
  162.              ( ( 0 -1  0)(   0  90))
  163.              ( ( 0  0 -1)(   0 180))
  164.              ( ( 1  1  1)(   0   0))))
  165.   ;Ingreso de datos por parte del usuario
  166.   (initget 1 "x y z -x -y -z")
  167.   (setq vista   (strcase (getstring "\nIngrese vista x/y/z/-x/-y/-z:") t))
  168.   (setq vista   (cadr (assoc vista ListaVistas)))
  169.   (setq conjunto (ssget))
  170.   (setq NumeroDeEntidades (sslength conjunto))
  171.   (setq i 0)
  172.   (setq NuevoConjunto nil)
  173.  
  174.   ;Para todo el conjunto seleccionado hacemos una nueva copia
  175.   ;y modificamos los bloques que tengan vistas
  176.   (repeat NumeroDeEntidades
  177.     (setq NombreEntidad (ssname conjunto i))
  178.     (setq i (+ i 1))
  179.     (setq entidad (entget NombreEntidad))
  180.     (setq TipoEntidad (cdr (assoc 0 entidad)))
  181.     (command "copy" NombreEntidad "" '(0 0 0)  '(0 0 0))
  182.     (if NuevoConjunto
  183.       (ssadd (entlast) NuevoConjunto)
  184.       (setq NuevoConjunto (ssadd (entlast))))
  185.     ; Si es un bloque modificamos para crear la nueva vista
  186.     ; si existe esta en caso contrario copiamos el bloque.
  187.     (if (equal TipoEntidad "INSERT")
  188.       (progn
  189.         (command "UCS" "E" (cdr (assoc -1 entidad)))
  190.     (setq NombreBloque (cdr (assoc 2 entidad)))
  191.     (setq sufijo  (substr NombreBloque 4 255))
  192.     (setq prefijo (PrefijoVista vista NombreEntidad))
  193.     (setq NombreBloqueNuevo  (strcat prefijo sufijo))
  194.         ;
  195.         ; Punto de insercion del nuevo bloque
  196.         ;
  197.         (setq insercionBloqueNuevo (cdr (assoc 10 entidad)))
  198.     ;
  199.         ; Factores de escala
  200.         ;
  201.          
  202.         (setq escalaXBloqueNuevo (cdr (assoc 41 entidad)))
  203.         (setq escalaYBloqueNuevo (cdr (assoc 42 entidad)))
  204.         (setq escalaZBloqueNuevo (cdr (assoc 43 entidad)))
  205.  
  206.  
  207.  
  208.         ; Vemos si el bloque a insertar tiene un vista
  209.     ; si no la tiene insertamos el mismo bloque
  210.     ; en caso contrario insertamos la vista
  211.     (if (tblsearch "BLOCK" NombreBloqueNuevo)
  212.       (progn
  213.         (setq BloqueNuevo (entget (entlast)))
  214.         ; si existe la vista borramos el bloque
  215.             ;(setq NombreEntidadConVista (entlast))
  216.  
  217.         (setq NuevoConjunto (ssdel (entlast) NuevoConjunto))
  218.         (entdel (entlast))
  219.  
  220.        ;(command "Insert" NombreBloqueNuevo '(0 0 0) "" "" "" )
  221.         (command "Insert" NombreBloqueNuevo  '(0 0 0) "XYZ" 
  222.                    escalaXBloqueNuevo escalaYBloqueNuevo escalaZBloqueNuevo "" )
  223.             (command "UCS" "W")
  224.            (if NuevoConjunto
  225.           (ssadd (entlast) NuevoConjunto)
  226.           (setq NuevoConjunto (ssadd (entlast))))
  227.         ; modificamos la lista de definicion del bloque original
  228.         ; para utilizarla en la vista que se inserto
  229.         (setq BloqueNuevo (subst (assoc -1 (entget (entlast))) (assoc -1 BloqueNuevo) BloqueNuevo))
  230.         (setq BloqueNuevo (subst (cons 2 NombreBloqueNuevo) (cons 2 NombreBloque) BloqueNuevo))
  231.         (setq BloqueNuevo (subst (cons 66 0) (assoc 66 entidad) BloqueNuevo))
  232.             
  233.         (entmod BloqueNuevo))))))
  234.     ;Procedemos a rotar las entidades
  235.     (grclear)
  236.     (command "SELECT" NuevoConjunto "")
  237.     (setq temp (cadr (assoc vista ListaRotacion)))
  238.     (setq fi (car temp) teta (cadr temp))
  239.     (setq punto (getpoint "\nIngrese punto de rotacion: "))
  240.     (if punto (rotacion NuevoConjunto punto fi teta))
  241.     ;Procedemos a crear el bloque
  242.     (setq viewdir (getvar "VIEWDIR"))
  243.     ; seleccionamos la vista superior por ser la vista desde donde
  244.     ; se insertan los bloque que continenen las distintas vistas
  245.     (command "VPOINT" '(0 0 1))
  246.     (grclear)
  247.     (command "SELECT" NuevoConjunto "")
  248.     (setq nombre (getstring "\nIngrese nombre del bloque: "))
  249.     (setq punto (getpoint "\nPunto de insercion: "))
  250.     ; Buscamos el nombre del bloque (de la vista) a ver si este ya existe
  251.     ; de existir se le pregunta al usuario si desea redefinirlo
  252.     ; en caso contrario se crea el nuevo bloque
  253.     (if (tblsearch "BLOCK" nombre)
  254.       (progn
  255.     (princ (strcat "\nEl nombre " nombre " ya existe"))
  256.     (initget 1 "S N")
  257.     (if (equal (strcase (getstring "\nRedefinirlos (s/n): ") t) "s")
  258.       (command "BLOCK"  nombre "Y" punto  NuevoConjunto "")
  259.       (command "ERASE" NuevoConjunto "")))
  260.       (command "BLOCK" nombre punto NuevoConjunto ""))
  261.     ; retormamos al estado de acad cuando lo llamo el usuario
  262.     (command "UCS" "W" )
  263.     (command "VPOINT" viewdir)
  264.     (setvar "GRIDMODE" gridmode)
  265.     (setvar "OSMODE"   osmode  )
  266.     (setvar "CMDECHO"  cmdecho ))
  267.  
  268.